home *** CD-ROM | disk | FTP | other *** search
-
- Sub FileCopy (Source$, Dest$)
- Screen.MousePointer = 11 'hourglass
- Open Source$ For Binary As #1
- whole = LOF(1) \ 32000 'numer of whole 32768 byte chunks
- part = LOF(1) Mod 32000 'remaining bytes at end of file
- buffer$ = String$(32000, 0)
- start& = 1
- Open Dest$ For Binary As #2
- For x = 1 To whole 'this for-next loop will copy 32,000
- Get #1, start&, buffer$ 'byte chunks at a time. If there is
- Put #2, start&, buffer$ 'less than 32,000 bytes in the file,
- start& = start& + 32000 'whole = 0 and the loop is bypassed.
- Next x
- buffer$ = String$(part, 0) 'this part of the routine will copy
- Get #1, start&, buffer$ 'the remaining bytes at the end of the
- Put #2, start&, buffer$ 'file.
- Close
-
- End Sub
-
- Sub IniCopy (lpApplication As String, lpKeyName As String, lpDefault As String, SubDir As String)
-
- 'start loop
- I = 0
- Do
- Screen.MousePointer = 11 'hourglass
- State% = DoEvents() 'allows list files to copied to be updated
- I = I + 1
- lpKeyName$ = "file" + Str$(I)
- GetStringvar% = GetPrivateProfileString(lpApplication$, lpKeyName$, lpDefault$, FileStr$, nSize%, lpFileName$)
- 'check named mark to end loop
- If Left$(FileStr$, 7) = "EndMark" Then
- Exit Do
- ElseIf Left$(FileStr$, 8) = "EndMark" Then
- Exit Do
- End If
-
- 'copy all program files to destination dir
- File$ = RTrim$(FileStr$) 'move spaces from right
- Dest$ = SubDir$ + "\" + File$
- Source$ = SD$ + File$
-
- IsFile$ = Dir$(Dest$) 'check if file already exist
- If IsFile$ = "" Then
- Install.Lbl_List.Caption = "Now copying file " + FileStr$
- FileCopy Source$, Dest$
- Install.List1.AddItem Dest$
- Else
- Screen.MousePointer = 0
- If WarnFlag = True Then 'check overwrite flag
- Warn.Lbl_Warn.Caption = "File already exist!, would you like to overwrite it? " + Dest$ 'give the user a change to prevent overwriting
- Warn.Show 1
- Else
- Install.Lbl_List.Caption = "Now copying file " + FileStr$
- Install.List1.AddItem Dest$
- End If
- End If
- Loop
- Screen.MousePointer = 0 'default
- End Sub
-
-